home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / xlispst.cpt / XLisp-Stat ƒ / Disk 1 / step.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1990-08-15  |  3.5 KB  |  81 lines
  1. ;;;; XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney
  2. ;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz
  3. ;;;; You may give out copies of this software; for conditions see the file
  4. ;;;; COPYING included with this distribution.
  5.  
  6. (defun step (expr)    
  7.   (let ((hooklevel 0)
  8.         (option nil)
  9.         #+macintosh (dialog (step-dialog))
  10.         (help-string "~%:b - break~%:h - help (this message)~%:n - next~%:s - skip~%:e - evaluate~%"))
  11.     (labels ((indent () (terpri) (dotimes (i (* 2 hooklevel)) (princ " ")))
  12.              (read-option (env) 
  13.                           (loop (princ " ? ")
  14.                                 (let ((c (read)))
  15.                                   (cond 
  16.                                     ((member c '(:s :n :b)) (return c))
  17.                                     ((equal c :h) (format t help-string))
  18.                                     ((equal c :e)
  19.                                      (print (evalhook (read) 
  20.                                                       nil 
  21.                                                       nil 
  22.                                                       env)))))))
  23.              (trace-hook-function    (expr &optional env)     
  24.                (setq hooklevel (1+ hooklevel))
  25.                (indent)
  26.                (format t    "Form:   ~s" expr)
  27.                (force-output)
  28.                (let ((value (evalhook expr
  29.                                       #'trace-hook-function
  30.                                       nil
  31.                                       env)))
  32.                  (indent)
  33.                  (format t    "Value:  ~s" value)
  34.                  (force-output)
  35.                  (setq hooklevel (1- hooklevel))
  36.                  value))
  37.              (step-hook-function (expr &optional env)     
  38.                (setq hooklevel (1+ hooklevel))
  39.                (indent)
  40.                (format t    "Form:   ~s" expr)
  41.                (force-output)
  42.                (setq option (if (atom expr) nil (read-option env)))
  43.                (if (equal option :b) (break)) 
  44.                (let ((value (evalhook expr
  45.                                       (if (equal option :s)
  46.                                           nil ;#'trace-hook-function
  47.                                           #'step-hook-function)
  48.                                       nil
  49.                                       env)))
  50.                  (indent)
  51.                  (format t    "Value:  ~s" value)
  52.                  (force-output)
  53.                  (setq hooklevel (1- hooklevel))
  54.                  value)))
  55.     (unwind-protect (step-hook-function expr)
  56.                     (terpri)
  57. #+macintosh         (send dialog :remove)))))
  58.  
  59. (defun step-dialog ()
  60.   (let* ((text-item (send text-item-proto :new "                           "
  61.                            :editable t)))
  62.     (send dialog-proto :new
  63.           (list text-item
  64.                 (send button-item-proto :new "Eval"
  65.                       :action
  66.                       #'(lambda ()
  67.                           (send *listener* :paste-string
  68.                                 (format nil ":e ~s~%" 
  69.                                         (send text-item :text)))))
  70.                 (send button-item-proto :new "Next"
  71.                       :action
  72.                       #'(lambda ()
  73.                           (send *listener* :paste-string
  74.                                 (format nil ":n~%"))))
  75.                 (send button-item-proto :new "Skip"
  76.                       :action
  77.                       #'(lambda ()
  78.                           (send *listener* :paste-string
  79.                                 (format nil ":s~%")))))
  80.           :type 'modeless)))
  81.